home *** CD-ROM | disk | FTP | other *** search
/ Aminet 7 / Aminet 7 - August 1995.iso / Aminet / comm / bbs / WWBBSDoors.lha / WWBBS / rexxDoors / StarTrek.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1995-04-27  |  36.1 KB  |  1,491 lines
  1. /*  STAR TREK - THE FINAL FRONTIER  - Online BBS Game
  2.     Written By Steve Berry
  3.     Rev A - 4/24/87 IBM 370
  4.     Rev B - 5/21/88
  5.          modified to run on Amiga
  6.     Rev C - 10/23/91
  7.          modified to run from CLI or BBBBS
  8.          also updated enemy from Klingons to Romulans
  9.     Mods for Atredes by Bob Hassel and Michael Cox
  10.     ANSI version & other enhancements by Michael Cox
  11.     BBBBS mods by Richard Lee Stockton
  12.     3 bugs fixed August 24,1993 by Charles Johnston
  13.     (1) Saved games would not survive a reload - FIXED
  14.     (2) After torpedos were used up one could continue firing them - FIXED
  15.     (3) After phasers were used up one could continue firing them -FIXED
  16. */
  17.  
  18. options results
  19.  
  20. CALL TIME('R')
  21. SIGNAL ON BREAK_C
  22. bbspath='wwbbs:'
  23. PARSE ARG UName . . . secs .
  24. IF secs='' THEN secs=3600
  25.  
  26. BBSIDENTIFY USER
  27. PARSE VAR RESULT UName From Acces .
  28. UName = substr(UName,2,length(UName)-2)
  29.  
  30. gamepath=''
  31. IF UName~='' & bbspath~='' THEN gamepath=bbspath'rexxDoors/Data/'
  32. maxtime=5000
  33. justcleared='true'
  34. highest=0
  35. highname=0
  36. HOM='H'
  37. RESET=''
  38. POS='0H'
  39. CLS='H'
  40. CLR=''
  41. CLL=''
  42. WHITEONBLUE=''
  43. REDONBLUE=''
  44. YELLOWONBLUE=''
  45. CYANONBLACK=''
  46. YELLOWONBLACK=''
  47. MAGENTAONBLACK=''
  48. BLUEONBLACK=''
  49. REDONYELLOW=''
  50. WHITE=''
  51. RED=''
  52. YELLOW=''
  53. BLACK=''
  54. GREEN=''
  55. CYAN=''
  56. MAGENTA=''
  57. BLUE=''
  58. IF ADDRESS()~='BAUD' THEN
  59.   DO
  60.     BLUE=GREEN
  61.     WHITEONBLUE=''
  62.     REDONBLUE=''
  63.     YELLOWONBLUE=''
  64.   END
  65. call time 'R'           /* reset timer */
  66. do i=1 to 10
  67.  highscore.i=0
  68.  highname.i=' '
  69. end
  70. stardate=time('E')
  71. junk=randu(time('S'))
  72. blanks='                                 '
  73.  
  74. call old_highest
  75. CALL mess CLS
  76. CALL mess BLUE||'                           Welcome to STARTREK!'
  77. CALL mess
  78. CALL mess YELLOW||'                             TOP TEN PLAYERS'
  79. CALL mess WHITE
  80. do i=1 to 10
  81.    if highscore.i=0 then iterate
  82.    CALL mess substr(blanks,1,20) highname.i substr(blanks,1,30-length(highname.i)) RIGHT(highscore.i,6)
  83. end
  84.  
  85. CALL mess CYAN
  86. CALL mess '         (You need an ANSI-compatible terminal to play this game.)'
  87. CALL mess 
  88. prompt( '               Do you need instructions (y/N)? ')
  89. res=readstr()
  90.  if res='Y' then
  91.    call instructions
  92.   else
  93.   do                             /* Anyone ever heard of BRACKETS? */
  94.    CALL mess
  95.    CALL mess 'You can get the instructions at any time by entering the word HELP.'
  96.    prompt( 'Hit [RETURN] to continue: ')
  97.    res=readstr()
  98.   end
  99. CALL mess CLS
  100. CALL mess 
  101. CALL mess
  102. prompt( 'Load and play an old game (y/N)? ')
  103. fn=readstr()
  104. CALL mess CLS
  105.  
  106. mission=1
  107.  
  108. /* Are we playing an OLD Game? */
  109.  
  110. if fn='Y' then
  111.     call load_old_game fn
  112. else
  113.  
  114. newmission:
  115.  CALL mess 'Please stand by... universe under construction'
  116.  select
  117.   when mission=1 then call init_variables_1
  118.   when mission=2 then call init_variables_2
  119.   when mission=3 then call init_variables_3
  120.   when mission=4 then call init_variables_4
  121.   when mission=5 then call init_variables_5
  122.   when mission=6 then call init_variables_6
  123.   when mission=7 then call init_variables_7
  124.   when mission=8 then call init_variables_8
  125.   when mission=9 then call init_variables_9
  126.   when mission=10 then call init_variables_10
  127. /*  otherwise */
  128.  end
  129.  
  130.  
  131. /* ********** */
  132. /* Main do loop */
  133. /* ************ */
  134.  
  135. main: /* added this function name so 'load_old_game:' could signal to it*/
  136.  
  137. starttime=stardate
  138. CALL mess CLS
  139. do until energy=0
  140. CALL checkBBS()
  141. CALL mess HOM
  142.  call print_quadrent x,y,ex,ey
  143.  t0=time('R')
  144.  
  145. /* get user input and parse the commands */
  146.  if stardate - starttime > maxtime then call toolong
  147.  prompt( 'Your command, Captain? ')
  148.  instring=readstr()
  149.  rc=parse_command(instring)
  150.  
  151. /* process the commands */
  152.  
  153.   if rc=0 then do
  154.     do loop=1 to 3
  155.      if arg1.loop='' then leave
  156.      call process_command arg1.loop,arg2.loop
  157.      if alive='no' | energy <= 0 then leave
  158.     end
  159.    end
  160.   else CALL mess "Command not understood. Enter HELP for reminder."
  161.  
  162. /* Check for illegal input */
  163.  
  164.   if missstat='completed' then do
  165.     CALL mess CLS
  166.     CALL mess
  167.     CALL mess ' CONGRATULATIONS !!! You have completed the mission!'
  168.     CALL mess
  169.      exit 0
  170.     end
  171.  
  172. /* Did player kill himself? */
  173.  
  174.  If alive='no' | energy <= 0 then do
  175.    CALL mess CLS
  176.    CALL mess
  177.    CALL mess
  178.    CALL mess
  179.    CALL mess
  180.    CALL mess ' Suicide is not in the BEST interests of the FEDERATION.'
  181.    CALL mess
  182.    CALL mess ' But you did get 'points' points.'
  183.    CALL mess
  184.    CALL mess
  185.    CALL mess
  186.    CALL mess 'Game over.'
  187.    CALL mess
  188.    CALL mess
  189.    exit
  190.   end
  191.  
  192. /* Time for a little wear and tear on the enterprize */
  193.  
  194.  call wear_and_tear
  195.  
  196. /* Is the Enterprize DEAD in Space? */
  197.  
  198.  If alive='no' then do
  199.    CALL mess CLS
  200.    CALL mess
  201.    CALL mess
  202.    CALL mess
  203.    CALL mess
  204.    CALL mess ' Sorry but you let the Enterprise deteriorate into '
  205.    CALL mess ' into a rusting hunk of space debris.'
  206.    CALL mess
  207.    CALL mess ' But you did get 'points' points.'
  208.    CALL mess
  209.    CALL mess
  210.    CALL mess
  211.    CALL mess 'Game over.'
  212.    CALL mess
  213.    CALL mess
  214.    exit
  215.   end
  216.  
  217. /* Ok. now it's the Bad guy's turn */
  218.  
  219. /* now call mission specific routine */
  220. /* for bad guy routine and points awarded */
  221.  
  222.  select
  223.   when mission=1 then call mission1
  224.   when mission=2 then call mission2
  225.   when mission=3 then call mission3
  226.   when mission=4 then call mission4
  227.   when mission=5 then call mission5
  228.   when mission=6 then call mission6
  229.   when mission=7 then call mission7
  230.   when mission=8 then call mission8
  231.   when mission=9 then call mission9
  232.   when mission=10 then call mission10
  233.  end
  234.  
  235. /* Is the Enterprize KILLED? KRUSHED? DESTROYED? */
  236.  
  237.  If alive='no' then do
  238.    CALL mess
  239.    CALL mess
  240.    CALL mess
  241.    CALL mess
  242.    CALL mess ' Sorry but you let your crew and the Federation down.'
  243.    CALL mess ' Perhaps you should consider another career.'
  244.    CALL mess
  245.    CALL mess ' But you did get 'points' points.'
  246.    CALL mess
  247.    CALL mess
  248.    CALL mess
  249.    CALL mess 'Game over.'
  250.    CALL mess
  251.    CALL mess
  252.    exit
  253.   end
  254.  
  255. /* end of the loop - now go print the screen */
  256. end
  257.  
  258.  
  259. /* ********************************************** */
  260. /* ********************************************** */
  261. /*          SUBROUTINE SECTION                    */
  262. /* ********************************************** */
  263. /* ********************************************** */
  264.  
  265.  
  266.  
  267. /* ********************************************** */
  268. /* ********************************************** */
  269. /*          SUBROUTINE LOAD_OLD_GAME              */
  270. /*  PASSED VALUES - fn                            */
  271. /* ********************************************** */
  272. /* ********************************************** */
  273.  
  274. load_old_game:
  275.  
  276.  
  277. bstr='   |o| * <->(B))\_ # '
  278. missstat='not yet'
  279. CALL mess 'Loading your previously saved game...'
  280. /* get variables */
  281.  if ~Open(fnn,gamepath||UName,'R') then
  282.  
  283. do
  284. CALL mess "Can't find a saved game for you! Exiting STARTREK."
  285. exit
  286. end
  287.  inn=Readln(fnn)
  288.  parse var inn stardate mission energy points x y ex ey shields klshields docked kltot
  289.  inn=Readln(fnn)
  290.  parse var inn status.0 status.1 status.2 status.3 status.4 status.5
  291.  
  292. /* start interval timer */
  293.  
  294. stardate=stardate + time('E')
  295.  
  296. /* Load galactic map */
  297.  
  298.  do l=0 to 9
  299.   inn1=Readln(fnn)
  300.   parse var inn1 map.l.0 map.l.1 map.l.2 map.l.3 map.l.4 map.l.5 map.l.6 map.l.7 map.l.8 map.l.9
  301.   
  302.  end
  303.  
  304.  do l=0 to 9
  305.   inn1=Readln(fnn)
  306.   parse var inn1 quad.l.0 quad.l.1 quad.l.2 quad.l.3 quad.l.4 quad.l.5 quad.l.6 quad.l.7 quad.l.8 quad.l.9
  307.  end
  308. alive='yes'
  309. junk=Close(fnn)
  310. signal main /* bug fix so old game is loaded properly and not overwritten as fresh game*/
  311. return
  312.  
  313. /* ********************************************** */
  314. /* ********************************************** */
  315. /*          SUBROUTINE INIT_VARIABLES_1           */
  316. /*  PASSED VALUES - none                          */
  317. /* ********************************************** */
  318. /* ********************************************** */
  319.  
  320. init_variables_1:
  321.  
  322. bstr='   |o| * <->(B))\_ # '
  323. alive='yes'
  324. energy=1000000
  325. x=0
  326. y=0
  327. points=0
  328. mission=1
  329. shields='down'
  330. kltot=0
  331. missstat='not yet'
  332.  
  333. do a=0 to 9
  334.  do b=0 to 9
  335.    map.a.b=random(0,1) * 100 + random(0,1)*10 + random(0,9)
  336.    if map.a.b > 99 then kltot=kltot + 1
  337.  end
  338. end
  339.  
  340. klshields=5000
  341. status.0=0
  342. status.1=0
  343. status.2=0
  344. status.3=0
  345. status.4=0
  346. status.5=0
  347. ex=5
  348. ey=4
  349.  
  350.  
  351. newscreen:
  352. /* initialize quadrent matrix */
  353.  
  354. enemies=map.x.y%100
  355. bases=(map.x.y - enemies * 100)%10
  356. stars=map.x.y - enemies * 100 - bases * 10
  357.  
  358. /* zero quad matrix */
  359.  
  360. do i=0 to 9
  361.  do j=0 to 9
  362.   quad.i.j=0
  363.  end
  364. end
  365.  
  366. /* locate the enterprize */
  367.  
  368. quad.ex.ey=1
  369.  
  370. /* put the stars in */
  371.  
  372. do a=0 to stars - 1
  373.  rx=random(0,9)
  374.  ry=random(0,9)
  375.  if quad.rx.ry=0 then quad.rx.ry=2
  376.  else a=a-1
  377. end
  378.  
  379. /* enemies? */
  380.  
  381. if enemies ~= 0 then do
  382.  do a=0 to enemies - 1
  383.    rx=random(0,9)
  384.    ry=random(0,9)
  385.    if quad.rx.ry=0 then quad.rx.ry=3
  386.    else a=a-1
  387.  end
  388. end
  389. /* bases ? */
  390.  
  391. if bases ~= 0 then do
  392.  do a=0 to bases - 1
  393.    rx=random(0,9)
  394.    ry=random(0,9)
  395.    if quad.rx.ry=0 then quad.rx.ry=4
  396.    else a=a-1
  397.  end
  398. end
  399. docked='no'
  400.  
  401. return
  402.  
  403. /* ********************************************** */
  404. /* ********************************************** */
  405. /*          SUBROUTINE PRINT_QUARDENT             */
  406. /*  PASSED VALUES - x, y ,ex ,ey                  */
  407. /* ********************************************** */
  408. /* ********************************************** */
  409.  
  410. print_quadrent:
  411.  
  412. call dock?  /* check to see if the Enterprize is docked */
  413.  
  414. stardate=stardate + time('E')
  415.  
  416. if status.5 < 1 | docked='yes' then astr=bstr
  417. else   astr='XXX|o|XXXXXXXXXXXXXXX'
  418. CALL mess RESET
  419. do i0=0 to 9
  420.  line='         '|| WHITEONBLUE
  421.  do j0=0 to 9
  422.   select
  423.     when quad.i0.j0=0 then line=line || substr(astr,quad.i0.j0 * 3 + 1,3)
  424.     when quad.i0.j0=1 then line=line || WHITE || substr(astr,quad.i0.j0 * 3 + 1,3)
  425.     when quad.i0.j0=2 then line=line || YELLOW || substr(astr,quad.i0.j0 * 3 + 1,3)||WHITE
  426.     when quad.i0.j0=3 then line=line || RED || substr(astr,quad.i0.j0 * 3 + 1,3)||WHITE
  427.     when quad.i0.j0=4 then line=line || GREEN || substr(astr,quad.i0.j0 * 3 + 1,3)||WHITE
  428.     when quad.i0.j0=5 then line=line || CYAN || substr(astr,quad.i0.j0 * 3 + 1,3)||WHITE
  429.     when quad.i0.j0=6 then line=line || MAGENTA || substr(astr,quad.i0.j0 * 3 + 1,3)||WHITE
  430.   otherwise nop
  431.   end
  432.  end
  433.  select
  434.   when i0=0 then line=line || YELLOWONBLACK ||'  Stardate: 'stardate'    '
  435.   when i0=1 then
  436.   do
  437.    if energy > 10000 then line=line || YELLOWONBLACK ||'  Energy: 'energy'    '
  438.    else
  439.    line=line || YELLOWONBLACK ||'  Energy: '||REDONYELLOW||energy'    '
  440.   end
  441.   when i0=2 then line=line || YELLOWONBLACK ||'  Quadrant:' y',' x'    '
  442.   when i0=3 then line=line || YELLOWONBLACK ||'  Sector:  ' ex',' ey '  '
  443.   when i0=4 & docked='yes' then line=line || YELLOWONBLACK || '  Condition: '||GREEN||'DOCKED'
  444.   when i0=4 & map.x.y > 99 & docked='no' then line=line || YELLOWONBLACK ||'  Condition: '||RED||'RED    '
  445.   when i0=4 & map.x.y < 100 & docked='no' then line=line || YELLOWONBLACK || '  Condition: '||GREEN||'Green    '
  446.   when i0=5 then
  447.  
  448.    do
  449.     if shields='UP' then line=line || YELLOWONBLACK ||'  Shields:' CYANONBLACK||'Up    '
  450.     else
  451.     line=line || YELLOWONBLACK ||'  Shields:' MAGENTAONBLACK||'Down    '
  452.    end
  453.   when i0=6 then line=line || YELLOWONBLACK ||'  Romulans left:' kltot'    '
  454.   when i0=7 then line=line || YELLOWONBLACK ||'  Points:' points'    '
  455.   otherwise line=line || RESET||'                       '
  456.  end
  457.  if (line ~= oldline.i0)|(justcleared='true') then CALL mess line; else CALL mess ""
  458.  oldline.i0=line
  459. end
  460. CALL mess RESET
  461. call clearbottom
  462. justcleared='false'
  463. return
  464.  
  465. /* ********************************************** */
  466. /* ********************************************** */
  467. /*           SUBROUTINE PARSE_COMMAND             */
  468. /*  PASSED VALUES - INSTRING                      */
  469. /* ********************************************** */
  470. /* ********************************************** */
  471.  
  472. parse_command:
  473.  
  474. parse arg arg1.1 arg2.1 arg1.2 arg2.2 arg1.3 arg2.3 .
  475.  
  476. /* string for recognition of commands */
  477.  
  478. comstr='COMFIRTORPHADISMAPSHOSENLONRAILOWSHIWARIMPLAUPROCAPLOGTRASHIDOWSAVGAMINSQUIDRISTAHELPOWSCASEE'
  479.  
  480. /* Check for no input */
  481.  
  482. if arg1.1='' then return -1
  483. if arg1.1='#' then
  484.   do
  485.   exit
  486.   end
  487.  
  488. /* trash all but the first three letters of each command */
  489.  
  490. do i=1 to 3
  491.  arg1.i=left(arg1.i,3)
  492.  arg2.i=left(arg2.i,3)
  493.  if arg1.i='' then leave
  494.  do j=0 to 30
  495.   if arg1.i=substr(comstr,j * 3 + 1,3) then leave
  496.  end
  497.  if j > 30  then return -1
  498.  if arg2.i='' then return 0
  499.   do j=0 to 30
  500.    if arg2.i=substr(comstr,j * 3 + 1,3) then leave
  501.   end
  502.  if j > 30  then return -1
  503. end
  504.  
  505. return 0
  506.  
  507. /* ********************************************** */
  508. /* ********************************************** */
  509. /*           SUBROUTINE PROCESS_COMMAND           */
  510. /*  PASSED VALUES - word1 , word2                 */
  511. /* ********************************************** */
  512. /* ********************************************** */
  513.  
  514. process_command:
  515.  
  516. arg word1,word2
  517. select
  518.   when word1='FIR' then call weapon_control word2
  519.   when word1='COM' then call compute word2
  520.   when word2='SEN' then call sensors word1
  521.   when word2='SCA' then call sensors word1
  522.   when word1='SEN' then call sensors word1
  523.   when word1='SCA' then call sensors word1
  524.   when word2='SHI' then call shield_control word1
  525.   when word2='DRI' then call engine_control word1
  526.   when word2='POW' then call engine_control word1
  527.   when word1='INS' then call instructions
  528.   when word2='INS' then call instructions
  529.   when word1='HEL' then call instructions
  530.   when word1='SAV' then call save_game word2
  531.   when word1='DIS' then call display_info word2
  532.   when word1='SEE' then call display_info word2
  533.   when word1='STA' then call display_info word2
  534.   when word1='LAU' then call launch_probe word2
  535.   when word1='CAP' then call captains_log word2
  536.   when word1='QUI' then
  537.   do
  538.   call new_highest
  539.   CALL mess 'Exiting STARTREK... play again soon!'
  540. exit
  541.   end
  542.   otherwise CALL mess 'Sorry - not understood'
  543. end
  544.  
  545. return
  546.  
  547. /* ********************************************** */
  548. /* ********************************************** */
  549. /*           SUBROUTINE WEAPON_CONTROL            */
  550. /*  PASSED VALUES - weapon                        */
  551. /* ********************************************** */
  552. /* ********************************************** */
  553.  
  554. weapon_control:
  555.  
  556. arg weapon
  557.  
  558. if (weapon ~= 'PHA') & (weapon ~= 'TOR') then do
  559.    CALL mess
  560.    CALL mess 'Weapon does not exist.'
  561.    return
  562.   end
  563.  
  564. /* Phasers section */
  565.  
  566. if weapon='PHA' then do
  567.   if map.x.y < 100 then do
  568.     CALL mess 'No targets to fire on.   '
  569.     return
  570.    end
  571.  
  572.  /* compute the distance  between Enterprize and Romulan */
  573.  
  574.  kx=0
  575.  ky=0
  576.  do i=0 to 9
  577.   do j=0 to 9
  578.    if quad.i.j=3 then do
  579.      kx=i
  580.      ky=j
  581.     end
  582.   end
  583.  end
  584. /* compute the distance (rough approximation) */
  585.  distance=((ex-kx)**2 + (ey-ky)**2)
  586.  do i=1 to 13 by .5
  587.   t0=distance/i
  588.   if t0 < i then leave
  589.  end
  590.  distance=i
  591.  energy=energy - 5000
  592.  hit=(1 - status.1)* 5000 - (distance * 500)
  593.  if hit < 0 then hit=0
  594.  klshields=klshields - hit
  595.  if hit=0 then
  596.    do  /* Bug fix for when out of phasers, old code let keep shooting endlessly*/
  597.     call mess 'Sorry Captain you have exhausted the Phaser Banks!'
  598.     call delay(100)
  599.     return
  600.    end
  601.  CALL mess
  602.  CALL mess 'PHASERS LOCKED ON TARGET '
  603.  CALL mess 'Phasers fired -'
  604.  if klshields <= 0 then do
  605.     CALL mess 'ROMULAN HIT WITH' hit ' units of energy'
  606.     CALL mess '*** ROMULAN DESTROYED! ***'
  607.     points=points + 50
  608.     klshields=5000
  609.     quad.kx.ky=0
  610.     map.x.y=map.x.y - 100
  611.     kltot=kltot - 1
  612.    end
  613.  else
  614.    do
  615.     CALL mess 'KILINGON HIT WITH' hit ' units of energy'
  616.     CALL mess 'The Romulan ship is still alive, Captain!'
  617.    end
  618.  end /* end of phaser routine */
  619. else do
  620.   /* Torpedo routine */
  621.     if weapon='TOR' & status.2 >.9 then  
  622.     do /* bug fix for when out of torpedos, old code let you shoot endlessly*/
  623.      call mess 'Sorry Captain we are all out of torpedos!'
  624.      call delay(100)
  625.      return
  626.     end
  627.      CALL mess 'Torpedos ready Captain.'
  628.      do until c=0
  629.       prompt( 'X vector, Captain (-1=left, 0=middle, 1=right)? ')
  630.       dy=readstr()
  631.       prompt( 'Y vector, Captain (-1=up, 0=middle, 1=down)? ')
  632.       dx=readstr()
  633.       if dx='' then dx=0
  634.       if dy='' then dy=0
  635.       if (dx=-1 | dx=0 | dx=1) & (dy=-1|dy=0|dy=1) then c=0
  636.       else
  637.        do
  638.         c=1
  639.         CALL mess 'Invalid vectors. Valid range for each is -1 to 1.'
  640.        end
  641.      end
  642.     tx=ex
  643.     ty=ey
  644.     do lp=0 to 9
  645.      t0=tx+dx
  646.      t1=ty+dy
  647.      if (t0 < 0) | (t0 > 9) | (t1 < 0) | (t1 > 9) then do
  648.        CALL mess ' Torpedo missed!'
  649.        return
  650.       end
  651.      space=quad.t0.t1
  652.      if space ~= 0 then select
  653.        when space=2 then do
  654.          CALL mess '*** Torpedo hits a STAR ***'
  655.          return
  656.         end
  657.        when space=3 then do
  658.          CALL mess '*** Torpedo hits a ROMULAN ***'
  659.          CALL mess '*** ROMULAN DESTROYED ***'
  660.          CALL mess 'Good shot, Captain!'
  661.          quad.t0.t1=0
  662.          map.x.y=map.x.y - 100
  663.          kltot=kltot - 1
  664.          points=points + 100
  665.          return
  666.         end
  667.        when space=4 then do
  668.          CALL mess '*** Torpedo hits a BASE ***'
  669.          CALL mess 'COURT MARTIAL IS IMMINENT!'
  670.          return
  671.         end
  672.        otherwise do
  673.          CALL mess '*** Torpedo hits the DEATHSTAR ***'
  674.          CALL mess 'Torpedo seems to have no effect!'
  675.          return
  676.         end
  677.        end
  678.       quad.t0.t1=6
  679.       tx=t0
  680.       ty=t1
  681.       CALL mess HOM
  682.       call print_quadrent
  683.       quad.tx.ty=0
  684.      end
  685.  end /* end of Torpedo routine */
  686. return
  687.  
  688. /* ********************************************** */
  689. /* ********************************************** */
  690. /*           SUBROUTINE WEAR_AND_TEAR             */
  691. /*  PASSED VALUES - none                          */
  692. /* ********************************************** */
  693. /* ********************************************** */
  694.  
  695. wear_and_tear:
  696.  
  697. pick=random(0,5)
  698. if docked='yes' then
  699.  if status.pick=0 then return
  700.  else status.pick=status.pick - .1
  701. else if status.pick < 1 then do
  702.   status.pick=status.pick + .1
  703.   if status.pick=1 then do
  704.     CALL mess 'Status report sir -'
  705.     select
  706.      when pick=0 then CALL mess 'Computer is in need of repair!'
  707.      when pick=1 then CALL mess 'Phasers are in need of repair!'
  708.      when pick=2 then CALL mess 'Torpedos are in need of repair!'
  709.      when pick=3 then CALL mess 'Warp Drive is in need of repair!'
  710.      when pick=4 then CALL mess 'Impulse Drive is in need of repair!'
  711.      when pick=5 then CALL mess 'Sensors are out of order!'
  712.     end
  713.    if status.3 > .9 & status.4 > .9 then do
  714.      CALL mess 'Captain sir ... we seem to be dead in space!'
  715.      CALL mess 'The warp drive and the impulse drive are out!'
  716.      alive='no'
  717.     end
  718.   end
  719.  end
  720. return
  721.  
  722.  
  723. /* ********************************************** */
  724. /* ********************************************** */
  725. /*           SUBROUTINE engine_control            */
  726. /*  PASSED VALUES - power                         */
  727. /* ********************************************** */
  728. /* ********************************************** */
  729.  
  730. engine_control:
  731.  
  732. arg power
  733.  
  734. CALL mess 'Scotty here captain.'
  735. if power='WAR' then do
  736.   if status.3 > 1.2 then
  737.   do
  738.   CALL mess 'Sorry Captain, warp drive is out of commission!'
  739.   return
  740.   end
  741.   prompt( 'What Warp factor Captain? ')
  742.   warp=readstr()
  743.   if warp='' then warp=0
  744.   do forever
  745.    prompt( 'Destination X vector (0-9)? ')
  746.    dy=readstr()
  747.    prompt( 'Destination Y vector (0-9)? ')
  748.    dx=readstr()
  749.    if datatype(dx,'W') & datatype(dy,'W') then leave
  750.    CALL mess 'Where?'
  751.   end
  752.    if x > 9 | y < 0 | x  < 0 | y > 9 then do
  753.     energy=energy - 5000
  754.     CALL mess 'Captain, the warp drive is in a bad way'
  755.     CALL mess 'and we are losing energy fast!'
  756.    end
  757.  /* if warp drive damaged degrade efficiency of energy consumption */
  758.   energy=energy - ((((dx-x)**2 + (dy-y)**2)/2.5)*1000+status.3*5000)
  759.   if dx > 9 | dy < 0 | dx < 0 | dy > 9 then do
  760.      CALL mess
  761.      CALL mess 'Warping out of the galaxy is not a good idea. Range 0-9 please.'
  762.      CALL mess
  763.      if shields='down' then do
  764.         CALL mess ' SHIELDS are DOWN --- the ENTERPRISE is caught, in the void of intergalatic space'
  765.         CALL mess ' Damage control report - WARP drive damaged, Impulse drive damaged, sensors out!'
  766.         status.3=status.3 + 1
  767.         status.4=status.4 + 1
  768.         status.5=1.1
  769.       end
  770.      else energy=energy - 5000
  771.     end
  772.   x=dx
  773.   y=dy
  774.   if x > -1 & x < 10 & y > -1 & y < 10 then call newscreen
  775.   end
  776.  else
  777.   do
  778.    if power ~= 'IMP' | status.4 > .9 then do
  779.      CALL mess 'Sorry Captain, impulse power is out of commission!'
  780.      return
  781.     end
  782.    else
  783.     do
  784.      CALL mess 'Aye Captain - Impulse power it is'
  785.      prompt( 'What factor, Captain? ')
  786.      do forever      
  787.        factor=readstr()
  788.        if datatype(factor,'W') then leave
  789.        CALL mess 'Whats that, Captain? '
  790.      end
  791.      if factor <= 0 & num='yes' then return
  792.      do until c=0
  793.       prompt( ' X vector (-1=left, 0=middle, 1=right)? ')
  794.       dy=readstr()
  795.       prompt( ' Y vector (-1=up, 0=middle, 1=down)? ')
  796.       dx=readstr()
  797.       if dx='' then dx=0
  798.       if dy='' then dy=0
  799.       if (dx=-1 | dx=0 | dx=1) & (dy=-1|dy=0|dy=1) then c=0
  800.       else
  801.        do
  802.         c=1
  803.         CALL mess 'Invalid vectors - valid range for each is -1 to 1.'
  804.        end
  805.      end
  806.     do i=0 to factor - 1
  807.      if ((ex+dx) < 0) | ((ex+dx) > 9) | ((ey+dy) < 0) |((ey+dy) > 9) then
  808.       do
  809.        CALL mess ' You have to use the Warp drive to exit the quadrant.'
  810.        return
  811.       end
  812.      t0=ex+dx
  813.      t1=ey+dy
  814.      space=quad.t0.t1
  815.      if space ~= 0 then select
  816.        when space=2 then do
  817.          CALL mess '*** COLLISION with STAR ***'
  818.          alive='no'
  819.         end
  820.        when space=3 then do
  821.          CALL mess '*** COLLISION with ROMULAN ***'
  822.          alive='no'
  823.         end
  824.        when space=4 then do
  825.          CALL mess '*** COLLISION with BASE ***'
  826.          alive='no'
  827.         end
  828.        otherwise do
  829.          CALL mess '*** SWALLOWED BY THE DEATHSTAR ***'
  830.          alive='no'
  831.         end
  832.        end
  833.       quad.ex.ey=0
  834.       quad.t0.t1=1
  835.       ex=t0
  836.       ey=t1
  837.       if alive='yes' then do
  838.         CALL mess HOM
  839.         call print_quadrent
  840.       end
  841.      end
  842.     end
  843.    end
  844.  
  845. /* Got to check to see if Enterprize is docked */
  846. dock?:
  847.  
  848. docked='no'
  849. do i1=-1 to 1
  850.  do j1=-1 to 1
  851.   if i1+ex > -1 & i1+ex < 10 & j1+ey > -1 & j1+ey < 10 then do
  852.     ta=i1+ex
  853.     tb=j1+ey
  854.     if quad.ta.tb=4 then do
  855.  
  856.      docked='yes'
  857.      t=status.0 + status.1 + status.2 + status.3 + status.4 + status.5
  858.      stardate=stardate + t
  859.      status.0=0
  860.      status.1=0
  861.      status.2=0
  862.      status.3=0
  863.      status.4=0
  864.      status.5=0
  865.     end
  866.    end
  867.  end
  868. end
  869. if kltot=0 then missstat='completed'
  870.  
  871. return
  872.  
  873. /* ********************************************** */
  874. /* ********************************************** */
  875. /*           SUBROUTINE SAVE_GAME                 */
  876. /*  PASSED VALUES - filename                      */
  877. /* ********************************************** */
  878. /* ********************************************** */
  879.  
  880. save_game:
  881.  
  882.  
  883.  
  884. missstat='not yet'
  885.  
  886. /* save variables */
  887.  
  888.  
  889.  if ~Open(fnn,gamepath||UName,'W') then do
  890.   CALL mess '***Open return code=' rc 'on 'bbspath'rexxDoors/Data/'||UName
  891.   CALL mess 'File may be in use, or is unable to be opened. Try again.'
  892.   return
  893.  end
  894. CALL mess 'Storing your game...'
  895. if Writeln(fnn,stardate mission energy points x y ex ey shields klshields docked kltot) < 1 then
  896.  do
  897. exit
  898. end
  899. if Writeln(fnn, status.0 status.1 status.2 status.3 status.4 status.5) < 1 then
  900.  do
  901. exit
  902. end
  903.  
  904. /* Save galactic map */
  905.  
  906.  do l=0 to 9
  907.   if Writeln(fnn,map.l.0 map.l.1 map.l.2 map.l.3 map.l.4 map.l.5 map.l.6 map.l.7 map.l.8 map.l.9) < 1 then
  908.   do
  909.     exit
  910.   end
  911.  end
  912.  
  913.  do l=0 to 9
  914. if Writeln(fnn,quad.l.0 quad.l.1 quad.l.2 quad.l.3 quad.l.4 quad.l.5 quad.l.6 quad.l.7 quad.l.8 quad.l.9) < 1 then
  915.   do
  916.   exit
  917.   end
  918.  end
  919.  if ~Close(fnn) then
  920.   do
  921. exit
  922. end
  923. return
  924.  
  925. /* ********************************************** */
  926. /* ********************************************** */
  927. /*           SUBROUTINE SENSORS                   */
  928. /*  PASSED VALUES - type                          */
  929. /* ********************************************** */
  930. /* ********************************************** */
  931.  
  932. sensors:
  933.  
  934. arg type
  935.  
  936. if status.5 < 1.1 then do
  937.   do i=-1 to 1
  938.    CALL mess '-------------------'
  939.    line=': '
  940.    do j=-1 to 1
  941.      t0=x+i
  942.      t1=y+j
  943.      if t0 < 0 | t0 > 9 | t1 < 0 | t1 > 9 then line=line || 'XXX :'
  944.      else
  945.       do
  946.        if map.t0.t1 < 100 & map.t0.t1 > 9 then line=line || ' '
  947.        if map.t0.t1 < 10 then line=line || '  '
  948.        line=line || map.t0.t1 || ' :'
  949.       end
  950.    end
  951.    CALL mess line
  952.   end
  953. end
  954. else
  955.   if status.5 > 1 then do
  956.     CALL mess ' Long-range sensors are out, captain!'
  957.     CALL mess
  958.   end
  959.  CALL mess '-------------------'
  960.  CALL mess
  961.  prompt( 'Hit RETURN to resume: ')
  962.  res=readstr()
  963.  call clearbottom
  964. return
  965.  
  966.  
  967. /* ********************************************** */
  968. /* ********************************************** */
  969. /*           SUBROUTINE SHIELD_CONTROL            */
  970. /*  PASSED VALUES - direction                     */
  971. /* ********************************************** */
  972. /* ********************************************** */
  973.  
  974. shield_control:
  975.  
  976. arg direction
  977.  
  978. if direction='RAI' then
  979.  if shields='UP' then do
  980.    CALL mess 'Shields are already up.'
  981.   end
  982.  else
  983.   do
  984.    shields='UP'
  985.    CALL mess 'Shields up, Captain.'
  986.    energy=energy - 3000
  987.   end
  988. else
  989.  if direction='LOW' then
  990.   if shields='down' then do
  991.     CALL mess 'Shields are already down.'
  992.    end
  993.   else
  994.    do
  995.     shields='down'
  996.     CALL mess 'Shields down, Captain.'
  997.     energy=energy + 3000
  998.    end
  999.  else
  1000.   do
  1001.    CALL mess ' I am confused by that order, Captain.'
  1002.    return
  1003.   end
  1004. return
  1005.  
  1006. /* ********************************************** */
  1007. /* ********************************************** */
  1008. /*           SUBROUTINE DISPLAY_INFO              */
  1009. /*  PASSED VALUES - what                          */
  1010. /* ********************************************** */
  1011. /* ********************************************** */
  1012.  
  1013. display_info:
  1014.  
  1015. arg what
  1016.  
  1017.   CALL mess CLS
  1018.   CALL mess
  1019.   CALL mess ' Status report for Enterprise - Stardate ' stardate
  1020.   CALL mess ' ----------------------------------'
  1021.   c=100 - status.0*100
  1022.   CALL mess ' Computer      status ' c'%'
  1023.   CALL mess ' ----------------------------------'
  1024.   c=100 - status.1*100
  1025.   CALL mess ' Phasers       status ' c'%'
  1026.   CALL mess ' ----------------------------------'
  1027.   c=100 - status.2*100
  1028.   CALL mess ' Torpedos      status ' c'%'
  1029.   CALL mess ' ----------------------------------'
  1030.   c=100 - status.3*100
  1031.   CALL mess ' Warp drive    status ' c'%'
  1032.   CALL mess ' ----------------------------------'
  1033.   c=100 - status.4*100
  1034.   CALL mess ' Impulse drive status ' c'%'
  1035.   CALL mess ' ----------------------------------'
  1036.   c=100 - status.5*100
  1037.   CALL mess ' Sensors       status ' c'%'
  1038.   CALL mess ' ----------------------------------'
  1039.   prompt( 'Hit RETURN to resume: ')
  1040.   res=readstr()
  1041. CALL mess CLS
  1042. justcleared='true'
  1043. return
  1044.  
  1045. /* ********************************************** */
  1046. /* ********************************************** */
  1047. /*           SUBROUTINE INSTRUCTIONS              */
  1048. /*  PASSED VALUES - none                          */
  1049. /* ********************************************** */
  1050. /* ********************************************** */
  1051.  
  1052. instructions:
  1053.  
  1054. CALL mess CLS
  1055. CALL mess 'Welcome to STARTREK.'
  1056. CALL mess
  1057. CALL mess 'This version of STARTREK is very simple and has been heavily'
  1058. CALL mess 'modified for better playability. The universe consists of a 10 by 10'
  1059. CALL mess 'grid of quadrants, each quadrant also consisting of a 10 by 10 grid.'
  1060. CALL mess '0,0 is the top left corner; Y is vertical and X is horizontal.'
  1061. CALL mess
  1062. CALL mess 'The object is to destroy all the Romulan ships in the galaxy.'
  1063. CALL mess
  1064. CALL mess 'You will see several objects as you play; the most common ones are:'
  1065. CALL mess
  1066. CALL mess '   |o|=the Enterprise'
  1067. CALL mess '   <->=Romulans'
  1068. CALL mess '   (B)=a Starbase'
  1069. CALL mess '    * =a star'
  1070. CALL mess
  1071. prompt( 'Hit [RETURN] to continue: ')
  1072. res=readstr()
  1073. CALL mess CLS
  1074. CALL mess 'COMMANDS'
  1075. CALL mess
  1076. CALL mess 'The command line takes two-word combinations. You can abbreviate'
  1077. CALL mess 'words to 3 letters. The most common commands are'
  1078. CALL mess
  1079. CALL mess '   RAISE SHIELDS (hint!)'
  1080. CALL mess '   LOWER SHIELDS'
  1081. CALL mess '   FIRE PHASERS'
  1082. CALL mess '   FIRE TORPEDOS'
  1083. CALL mess '   IMPULSE POWER'
  1084. CALL mess '   WARP DRIVE'
  1085. CALL mess '   SCANNERS (or SENSORS)'
  1086. CALL mess '   STATUS'
  1087. CALL mess '   SAVE (Saves game WITHOUT exiting)'
  1088. CALL mess '   QUIT (Exit game entirely)'
  1089. CALL mess '   HELP (Gives you this file again)'
  1090. CALL mess
  1091. prompt( 'Hit [RETURN] to continue: ')
  1092. res=readstr()
  1093. CALL mess CLS
  1094. CALL mess 'VECTORS: When firing torpedoes or moving the ship you are asked'
  1095. CALL mess 'for X and Y vectors. Each of these can be -1, 0, or 1. This'
  1096. CALL mess 'indicates the X or Y direction. For instance, if X=0 and Y=1,'
  1097. CALL mess 'this indicates a vector straight down. If both are -1, this would'
  1098. CALL mess 'indicate an upper-left direction.'
  1099. CALL mess
  1100. CALL mess 'IN ORDER TO STAY ALIVE you must NOT run out of energy, exceed'
  1101. CALL mess 'Stardate 5000.0, or be caught with your shields down.'
  1102. CALL mess
  1103. CALL mess 'The Enterprise will from time to time need maintenance. Do this'
  1104. CALL mess 'by pulling up next to a Starbase.'
  1105. CALL mess
  1106. prompt( 'Hit [RETURN] to continue: ')
  1107. res=readstr()
  1108. CALL mess CLS
  1109. justcleared='true'
  1110. return
  1111.  
  1112. /* ********************************************** */
  1113. /* ********************************************** */
  1114. /*           SUBROUTINE CAPTAINS_LOG              */
  1115. /*  PASSED VALUES - word2                         */
  1116. /* ********************************************** */
  1117. /* ********************************************** */
  1118.  
  1119. captains_log:
  1120.  
  1121. CALL mess 'Sorry, not implemented'
  1122.  
  1123. return
  1124.  
  1125. /* ********************************************** */
  1126. /* ********************************************** */
  1127. /*           SUBROUTINE LAUNCH_PROBE              */
  1128. /*  PASSED VALUES - word2                         */
  1129. /* ********************************************** */
  1130. /* ********************************************** */
  1131.  
  1132. launch_probe:
  1133.  
  1134. CALL mess 'Sorry, not implemented'
  1135.  
  1136. return
  1137.  
  1138. /* ********************************************** */
  1139. /* ********************************************** */
  1140. /*           SUBROUTINE COMPUTE                   */
  1141. /*  PASSED VALUES - word2                         */
  1142. /* ********************************************** */
  1143. /* ********************************************** */
  1144.  
  1145. compute:
  1146. CALL mess 'Sorry, not implemented'
  1147.  
  1148.  
  1149. return
  1150.  
  1151. /* ********************************************** */
  1152. /* ********************************************** */
  1153. /*           SUBROUTINE MISSION1                  */
  1154. /*  PASSED VALUES - none                          */
  1155. /* ********************************************** */
  1156. /* ********************************************** */
  1157.  
  1158. mission1:
  1159.  
  1160. /* make the Romulans active aggressors */
  1161. /* Mission 1 - WAR with the ROMULANS! */
  1162.  
  1163. /* Any Romulans in the sector? */
  1164. if map.x.y > 99 then do
  1165.   do i=0 to 9     /* locate the Romulan in the quadrent */
  1166.    do j=0 to 9
  1167.     if quad.i.j=3 then
  1168.      do
  1169.       tx=i
  1170.       ty=j
  1171.      end
  1172.    end
  1173.   end
  1174.  
  1175.  /* got him - now move and fire */
  1176.  if tx > ex then t0=-1
  1177.  if tx=ex then t0=0
  1178.  if tx < ex then t0=1
  1179.  if ty > ey then t1=-1
  1180.  if ty=ey then t1=0
  1181.  if ty < ey then t1=1
  1182.  /* now how much? */
  1183.  factor=((tx-ex)**2 + (ty-ey)**2)
  1184.  do i=1 to 13 by .5
  1185.   tm=factor/i
  1186.   if tm < i then leave
  1187.  end
  1188.  factor=i%1
  1189.  /* now move him */
  1190.  
  1191. kl='yes'
  1192.  do i=0 to factor - 1
  1193.   if factor < 1 then leave
  1194.   t2=tx+t0
  1195.   t3=ty+t1
  1196.   if t2 < 0 | t2 > 9 | t3 < 0 | t3 > 9 then leave
  1197.   space=quad.t2.t3
  1198.   if space=1 then leave
  1199.   if space ~= 0 & kl='yes' then select
  1200.     when space=2 then do
  1201.       CALL mess '*** ROMULAN COLLIDES with STAR ***'
  1202.       quad.tx.ty=0
  1203.       map.x.y=map.x.y - 100
  1204.       kltot=kltot - 1
  1205.       kl='no'
  1206.      end
  1207.     when space=3 then do
  1208.       CALL mess '*** ROMULAN COLLIDES with ROMULAN ***'
  1209.       quad.tx.ty=0
  1210.       quad.t2.t3=0
  1211.       map.x.y=map.x.y - 200
  1212.       kltot=kltot - 2
  1213.       kl='no'
  1214.      end
  1215.     when space=4 then do
  1216.       CALL mess '*** ROMULAN COLLIDES with BASE ***'
  1217.       quad.tx.ty=0
  1218.       quad.t2.t3=0
  1219.       map.x.y=map.x.y - 100
  1220.       kltot=kltot - 1
  1221.       kl='no'
  1222.      end
  1223.     otherwise
  1224.      do
  1225.       CALL mess space
  1226.       CALL mess '*** ROMULAN EATEN FOR LUNCH! ***'
  1227.       points=points + 50
  1228.       quad.tx.ty=0
  1229.       map.x.y=map.x.y - 100
  1230.       kltot=kltot - 1
  1231.       kl='no'
  1232.      end
  1233.    end
  1234.   if kl='yes' then do
  1235.     quad.tx.ty=0
  1236.     quad.t2.t3=3
  1237.     tx=t2
  1238.     ty=t3
  1239.     CALL mess HOM
  1240.     call print_quadrent
  1241.    end
  1242.  end
  1243. if docked='yes' then return
  1244. /* now fire */
  1245. if kl='yes' then do
  1246.   amount=klshields/5000 * random(100,500) * 10
  1247.   if amount > 1000 & shields='down' then do
  1248.    CALL mess '--- ROMULAN FIRES PHASERS ---'
  1249.    CALL mess '*** ENTERPRISE SHIELDS ARE DOWN ***'
  1250.    CALL mess '*** ENTERPRISE HIT with 'amount ' UNITS OF ENERGY ***'
  1251.    CALL mess '*** ENTERPRISE DESTROYED ***'
  1252.    alive='no'
  1253.   end
  1254.   if amount < 3000 & shields='UP' then do
  1255.    CALL mess '--- ROMULAN FIRES PHASERS ---'
  1256.    CALL mess '*** ENTERPRISE SHIELDS ARE UP ***'
  1257.    CALL mess '*** Shields absorb impact --- no damage ***'
  1258.    energy=energy - amount
  1259.   end
  1260.   if amount > 3000 & shields='UP' then do
  1261.    CALL mess '--- ROMULAN FIRES PHASERS ---'
  1262.    CALL mess '*** ENTERPRISE SHIELDS ARE UP ***'
  1263.    hit=amount - 3000
  1264.    CALL mess '*** ENTERPRISE HIT WITH' hit ' UNITS OF ENERGY ***'
  1265.    energy=energy - amount
  1266.    do i=0 to hit/100
  1267.     call wear_and_tear
  1268.    end
  1269.   end
  1270.   if amount < 1001 & shields='down' then do
  1271.     CALL mess '--- ROMULAN FIRES PHASERS ---'
  1272.     CALL mess '*** ENTERPRISE SHIELDS ARE DOWN ***'
  1273.     hit=amount
  1274.     CALL mess '*** ENTERPRISE HIT WITH' hit ' UNITS OF ENERGY ***'
  1275.     do i=0 to hit/100
  1276.      call wear_and_tear
  1277.     end
  1278.    end
  1279.   end
  1280. end
  1281.  
  1282. /* end for Romulans in sector ... if < 3 here go get some */
  1283.  
  1284. if map.x.y < 299 & alive='yes' then do
  1285.  found='no'
  1286.  
  1287.   do i=-1 to 1     /* locate a Romulan in the Galaxy */
  1288.    do j=-1 to 1
  1289.      tx=i+x
  1290.      ty=j+y
  1291.      if (tx > -1) & (tx < 10) & (ty > -1) & (ty < 10) then do
  1292.        if (map.tx.ty > 99) & ((i ~=0 )|(j ~=0 )) then do
  1293.          found='yes'
  1294.          i=1
  1295.          j=1
  1296.         end
  1297.       end
  1298.    end
  1299.   end
  1300. if found='yes' then do
  1301.   CALL mess 'CAPTAIN! A Romulan warship has just warped into the quadrant!'
  1302.   map.tx.ty=map.tx.ty - 100
  1303.   map.x.y=map.x.y + 100
  1304.   do until a=1
  1305.    rx=random(0,9)
  1306.    ry=random(0,9)
  1307.    if quad.rx.ry=0 then do
  1308.      quad.rx.ry=3
  1309.      a=1
  1310.     end
  1311.    else a=0
  1312.   end
  1313.  end
  1314. end
  1315. if kltot=0 then missstat='completed'
  1316. return
  1317.  
  1318. /* MISSION 2 */
  1319.  
  1320. init_variables_2:
  1321.  
  1322. return
  1323.  
  1324.  
  1325. mission2:
  1326.  
  1327. return
  1328.  
  1329. /* MISSION3 */
  1330.  
  1331. init_variables_3:
  1332.  
  1333. return
  1334.  
  1335. mission3:
  1336.  
  1337.  
  1338. /* MISSION4 */
  1339.  
  1340. init_variables_4:
  1341.  
  1342. return
  1343.  
  1344. mission4:
  1345.  
  1346.  
  1347. /* MISSION5 */
  1348.  
  1349. init_variables_5:
  1350.  
  1351. return
  1352.  
  1353. mission5:
  1354.  
  1355. /* MISSION6 */
  1356.  
  1357. init_variables_6:
  1358.  
  1359. return
  1360.  
  1361. mission6:
  1362.  
  1363. /* MISSION7 */
  1364.  
  1365. init_variables_7:
  1366.  
  1367. return
  1368.  
  1369. mission7:
  1370.  
  1371. /* MISSION8 */
  1372.  
  1373. init_variables_8:
  1374.  
  1375. return
  1376.  
  1377. mission8:
  1378.  
  1379. /* MISSION9 */
  1380.  
  1381. init_variables_9:
  1382.  
  1383. return
  1384.  
  1385. mission9:
  1386.  
  1387. return
  1388.  
  1389. old_highest:
  1390.  if ~Open(fnn,gamepath'HighScore','R') then return
  1391.  do i=1 to 10
  1392.   highname.i=Readln(fnn)
  1393.   highscore.i=Readln(fnn)
  1394.  end
  1395.  junk=Close(fnn)
  1396. return
  1397.  
  1398.  
  1399.  
  1400. new_highest:
  1401.  if UName='' then return  /* saves from screwups from running offline */
  1402.  if points <= highscore.10 then return
  1403.  CALL mess 'CONGRATULATIONS!'
  1404.  CALL mess 'You are in the top 10! Saving your name and score for posterity...'
  1405.  highscore.10=points
  1406.  highname.10=UName
  1407.  do forever
  1408.    changes=0
  1409.    do i=1 to 9
  1410.     ihatearexx=i+1
  1411.     if highscore.ihatearexx > highscore.i then
  1412.      do
  1413.       temp=highscore.i
  1414.       tempname=highname.i
  1415.       highscore.i=highscore.ihatearexx          /* Bubblehead sort */
  1416.       highname.i=highname.ihatearexx
  1417.       highscore.ihatearexx=temp
  1418.       highname.ihatearexx=tempname
  1419.       changes=1
  1420.      end
  1421.    end
  1422.    if changes=0 then leave
  1423.  end
  1424.    if ~Open(fnn,gamepath'HighScore','W') then return
  1425.    do i=1 to 10
  1426.      if Writeln(fnn,highname.i) < 1 then return
  1427.      if Writeln(fnn,highscore.i) < 1 then return
  1428.    end
  1429.    junk=Close(fnn)
  1430. return
  1431.  
  1432.  
  1433. clearbottom:
  1434.  CALL mess POS
  1435.  CALL mess CLR
  1436. return
  1437.  
  1438.  
  1439. toolong:
  1440. CALL mess ''
  1441. CALL mess 'Sorry, time up for this round.'
  1442. prompt( 'Would you like to SAVE your game before exiting (Y/N)? ')
  1443. choice=readstr()
  1444. if choice='Y' then call save_game
  1445. if points > highest then call new_highest
  1446.  
  1447. BREAK_C:
  1448. CALL mess 'Exiting STARTREK... play again soon!'
  1449. exit
  1450. return
  1451.  
  1452. readstr: procedure
  1453. str=''
  1454. out=readch(STDIN)
  1455.  call WRITECH(STDOUT,out)
  1456.  do while out~=D2C(13)
  1457.       if out=D2C(8) then do
  1458.          str=SUBSTR(str,1,LENGTH(str)-1)
  1459.          call WRITECH(STDOUT,' ')
  1460.          call WRITECH(STDOUT,out)
  1461.          end
  1462.       else
  1463.          str=INSERT(str,out)
  1464.       out=readch(STDIN)
  1465.       call WRITECH(STDOUT,out)
  1466.     end
  1467. say '0D'x
  1468. return(UPPER(str))
  1469.  
  1470. prompt: procedure
  1471. parse arg str
  1472. writech(STDOUT,str)
  1473. return 1
  1474.  
  1475. checkBBS:
  1476. IF ADDRESS()~='BAUD' THEN RETURN 0
  1477. IF TIME('E')>secs THEN SIGNAL toolong
  1478. dcd
  1479. IF RC=0 THEN EXIT
  1480. temp=secs-TIME('E')
  1481. IF temp<120 THEN SAY '*** Only' temp 'seconds left! ***'CR
  1482. RETURN 0
  1483.  
  1484.  
  1485. mess:
  1486. PARSE ARG string
  1487. SAY string'0D'x
  1488. RETURN
  1489.  
  1490. /* end */
  1491.